home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr49 / pgp23src.zip / PGP.EL1 < prev    next >
Lisp/Scheme  |  1993-03-07  |  9KB  |  267 lines
  1. To: warlord@MIT.EDU (Derek Atkins)
  2. In-reply-to: warlord@MIT.EDU's message of 1 Mar 1993 03:59:41 GMT
  3. Subject: Request for Mailer Scripts
  4. BCC: jtkohl
  5. Full-name: John T Kohl
  6. X-US-Snail: DEC, 110 Spit Brook Road, M/S ZKO3-3/U14, Nashua, NH  03062
  7. --text follows this line--
  8. here's some elisp I got from Bill Sommerfeld, and hacked up a bit
  9. myself:
  10. ;;;
  11. ;;; wrapper for the "Pretty-Good-Privacy" program.
  12. ;;;
  13.  
  14. (defvar pgp-program (expand-file-name "/usr/local/bin/pgp") 
  15.   "*Name of the PGP executable")
  16. (defvar pgp-sender-name "jtkohl@zk3"
  17.   "*Name of secret key to use for signing/encrypting messages with PGP")
  18.  
  19. (require 'rmail)
  20. (require 'terminal)
  21. (require 'backquote)
  22.  
  23. (defvar pgp-encrypt-mail t)
  24. (defvar pgp-sign-mail t)
  25. (defvar pgp-output-mode-map nil
  26.   "Keymap used in PGP Output mode")
  27.  
  28. (defvar pgp-finished)
  29. (make-variable-buffer-local 'pgp-finished)
  30. (set-default 'pgp-finished nil)
  31. (defvar termhook-finished)
  32. (make-variable-buffer-local 'termhook-finished)
  33. (set-default 'termhook-finished nil)
  34.  
  35. (defun pgp-output-quit ()
  36.   (interactive)
  37.   (let ((buffer (current-buffer)))
  38.     (switch-to-buffer
  39.      (if (and (boundp 'pgp-prev-buffer) (bufferp pgp-prev-buffer))
  40.      pgp-prev-buffer
  41.        (other-buffer buffer)))
  42.     (bury-buffer buffer)))
  43.  
  44. (defun pgp-keymap-init ()
  45.   (setq pgp-output-mode-map (make-keymap))
  46.   (suppress-keymap pgp-output-mode-map)
  47.   (define-key pgp-output-mode-map " " 'scroll-up)
  48.   (define-key pgp-output-mode-map "\177" 'scroll-down)
  49.   (define-key pgp-output-mode-map "q" 'pgp-output-quit))
  50.  
  51. (if (not pgp-output-mode-map)
  52.   (pgp-keymap-init))
  53.  
  54. (defun pgp-output-mode ()
  55.   (interactive)
  56.   (fundamental-mode)
  57.   (setq mode-name "PGP-Output")
  58.   (setq major-mode 'pgp-output-mode)
  59.   (setq buffer-read-only t)
  60.   (setq buffer-auto-save-file-name nil)
  61.   (use-local-map pgp-output-mode-map))
  62.  
  63.  
  64. ;; a "continuation".. what we do after pgp is done..
  65. ;; this could set the current buffer (the terminal emulator one) 
  66. ;; into a new major mode (pgp-after-mode) to let you do things like:
  67. ;;  a) easily dismiss the pgp window
  68. ;;  b) view any output files.
  69. ;;  c) see what the "labelling" on the files was
  70. ;; (i.e., signature, encrypted); this shows up in mode line, not file!
  71.  
  72. (defun pgp-continue-frob (out-filename prev-buffer)
  73.   (cond ((file-exists-p out-filename)
  74.      (set-buffer (get-buffer-create "*PGP Output*"))
  75.      (make-variable-buffer-local 'pgp-prev-buffer)
  76.      (setq pgp-prev-buffer nil)
  77.      (setq buffer-read-only nil)
  78.      (erase-buffer)
  79.      (insert-file-contents out-filename)
  80.      (delete-file out-filename)
  81.      (switch-to-buffer "*PGP Output*")
  82.      (pgp-output-mode)
  83.      (setq pgp-prev-buffer prev-buffer))
  84.     (t (message "PGP command completed with no output file" ))))
  85.  
  86. (defun pgp-continue-in-place  (out-file buf min max cont)
  87.   (cond ((file-exists-p out-file)
  88.      (switch-to-buffer buf)
  89.      (goto-char min)
  90.      (delete-region min max)
  91.      (insert-file-contents out-file)
  92.      (delete-file out-file)
  93.      (apply cont nil))
  94.     (t (message "PGP command completed with no output file"))))
  95.  
  96. (defun pgp-mail-continue ()
  97.   (mail-to)
  98.   (insert (save-excursion
  99.         (set-buffer "*PGP*")    ;!!!
  100.         (goto-char (point-min))
  101.         (re-search-forward "Recipient's")
  102.         (re-search-forward "user ID: \\(.*$\\)")
  103.         (buffer-substring (match-beginning 1) (match-end 1)))))
  104.  
  105. (defvar pgp-base-file-name nil
  106.   "Default base file name for PGP temp files; defaults to a file in
  107. /tmp with your UNIX user id in it.")
  108.  
  109. (defun pgp-check-tempname ()
  110.   (if pgp-base-file-name
  111.       ()
  112.     (setq pgp-base-file-name  (format "/tmp/pgp%d" (user-real-uid)))))
  113.  
  114. (defun pgp-frob-region-1 (min max cont1 &optional opt1 opt2)
  115.   (pgp-check-tempname)
  116.   (let ((temp-filename (format "%s.txt" pgp-base-file-name))
  117.     (out-filename  (format "%s.asc" pgp-base-file-name))
  118.     (prev-buffer (current-buffer)))
  119.     (if (file-exists-p temp-filename)
  120.     (delete-file temp-filename))
  121.     (if (file-exists-p out-filename)
  122.     (delete-file out-filename))
  123.     (write-region min max temp-filename)
  124.     
  125.     (let ((buf (get-buffer-create "*PGP*")))
  126.       (switch-to-buffer buf)
  127.       (erase-buffer)
  128.       (let ((terminal-mode-hook
  129.          (function
  130.           (lambda ()
  131.         (make-variable-buffer-local 'terminal-finished-hook) 
  132.         (setq terminal-finished-hook (apply cont1 out-filename prev-buffer nil))
  133.         (setq termhook-finished t)
  134.         (if (and
  135.              (boundp 'pgp-finished)
  136.              pgp-finished)
  137.             (let ((nhooks terminal-finished-hook))
  138.               (fundamental-mode) ; in the *PGP* buffer; nukes hooks!
  139.               (run-hooks 'nhooks)))))))
  140.     (terminal-emulator buf
  141.                pgp-program
  142.                (nconc (list "-o" out-filename)
  143.                   opt1
  144.                   (list temp-filename)
  145.                   opt2))))))
  146.  
  147. (defun pgp-frob-region  (min max &optional opt1 opt2)
  148.   (pgp-frob-region-1 min max
  149.              (function
  150.               (lambda (out-filename buf)
  151.                   (` (lambda () 
  152.                    (pgp-continue-frob
  153.                     (, out-filename)
  154.                     (, buf))))))
  155.              opt1 opt2))
  156.  
  157. (defun pgp-frob-region-in-place (min max &optional opt1 opt2 cont)
  158.   (let ((cur-buf (current-buffer)))
  159.     (pgp-frob-region-1 min max 
  160.                (function
  161.             (lambda (out-filename buf)
  162.               (` (lambda () 
  163.                    (pgp-continue-in-place (, out-filename)
  164.                               (, cur-buf)
  165.                               (, min)
  166.                               (, max)
  167.                               (quote (, cont)))))))
  168.                opt1 opt2)))
  169.  
  170. (defun pgp-encrypt-ascii-region (min max to)
  171.   (interactive "r\nsRecipient name: ")
  172.   (pgp-frob-region min max (list "-eaw") (list to)))
  173.  
  174. (defun pgp-decrypt-ascii-region (min max)
  175.   (interactive "r")
  176.   (pgp-frob-region min max nil nil))
  177.  
  178. (defun pgp-sign-ascii-region (min max)
  179.   "Sign the region with PGP, using cleartext signatures."
  180.   (interactive "r")
  181.   (pgp-frob-region min max (list "-swat") nil))
  182.  
  183. (defun pgp-encrypt-ascii-buffer (to)
  184.   "Encrypt a buffer and use PGP armor for the output."
  185.   (interactive "sRecipient name: ")
  186.   (pgp-encrypt-ascii-region (point-min) (point-max) to))
  187.  
  188. (defun pgp-decrypt-ascii-buffer ()
  189.   "Apply PGP to the current buffer."
  190.   (interactive)
  191.   (pgp-decrypt-ascii-region (point-min) (point-max)))
  192.  
  193. (defun pgp-sign-encrypt-ascii-buffer (to)
  194.   (interactive "sRecipient name: ")
  195.   (pgp-frob-region (point-min) (point-max) (list "-seaw") (list to)))
  196.  
  197. (defun pgp-sign-ascii-buffer ()
  198.   "Sign the current buffer with PGP, using cleartext signatures."
  199.   (interactive)
  200.   (pgp-sign-ascii-region (point-min) (point-max)))
  201.  
  202. (defun pgp-sign-encrypt-ascii-buffer-in-place (to)
  203.   (interactive "s(in place) Recipient name: ")
  204.   (pgp-frob-region-in-place (point-min) (point-max) (list "-seaw") (list to)))
  205.  
  206. (defun pgp-sign-encrypt-ascii-region (min max to)
  207.    (interactive "r\nsRecipient name: ")
  208.    (pgp-frob-region min max (list "-seaw") (list to)))
  209.  
  210. (defvar pgp-mail-frob-flags "-easw"
  211.   "*Flags to pass to pgp for frobbing mail.")
  212.  
  213. (defun pgp-frob-mail (to)
  214.   "Take an in-progress mail message and 'frob' it."
  215.   (interactive "sMail Recipient name: ")
  216.   (goto-char (point-min))
  217.   (re-search-forward mail-header-separator)
  218.   (goto-char (match-beginning 0))
  219.   (forward-line 1)
  220.   (save-excursion
  221.     (insert (buffer-substring (point-min) (point))))
  222.   (pgp-frob-region-in-place (point) (point-max)
  223.                 (list pgp-mail-frob-flags "-u" pgp-sender-name)
  224.                 (list to)
  225.                 'pgp-mail-continue))
  226.  
  227. (global-set-key "\C-c\C-p\C-e" 'pgp-encrypt-ascii-buffer)
  228. (global-set-key "\C-c\C-p\C-r" 'pgp-encrypt-ascii-region)
  229. (global-set-key "\C-c\C-p\C-s" 'pgp-sign-ascii-buffer)
  230. (global-set-key "\C-c\C-p\C-m" 'pgp-frob-mail)
  231. (global-set-key "\C-c\C-p\C-d" 'pgp-decrypt-ascii-buffer)
  232.  
  233. (global-set-key "\C-cpm" 'pgp-frob-mail)
  234. (define-key rmail-mode-map "V" 'pgp-decrypt-ascii-buffer)
  235.  
  236. ;;; How to deal with the race?  the sentinel may get called
  237. ;;; *before* terminal-emulator finishes its initialization.  So we set
  238. ;;; up a local variable here so that our terminal-mode-hook will undo
  239. ;;; the damage if PGP is finished.
  240. ;;
  241. ;; from terminal.el, modified:
  242.  
  243. (defun te-sentinel (process message)
  244.   (cond ((eq (process-status process) 'run))
  245.     ((null (buffer-name (process-buffer process)))) ;deleted
  246.     (t (let ((b (current-buffer))
  247.          (done-hooks (and    ; added: WES
  248.                   (boundp 'terminal-finished-hook)
  249.                   terminal-finished-hook)))
  250.          (save-excursion
  251.            (set-buffer (process-buffer process))
  252.            (setq buffer-read-only nil)
  253.            (goto-char (point-max))
  254.            (delete-blank-lines)
  255.            (delete-horizontal-space)
  256.            (insert "\n*******\n" message "*******\n")
  257.            (fundamental-mode)    ; added/moved: WES/JTK
  258.            (setq pgp-finished t)    ; JTK
  259.            (sit-for 1))
  260.          (if (and (eq b (process-buffer process))
  261.               (waiting-for-user-input-p))
  262.          (progn (goto-char (point-max))
  263.             (recenter -1)))
  264.          (run-hooks 'done-hooks))))) ;added: WES
  265.  
  266.  
  267.